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-- ListerRoutines.mesa; edited by Johnsson; July 20, 1978 12:10 PM 

DIRECTORY 

AllocDefs: FROM "allocdefs", 

AUoDefs: FROM "altodefs", 

BcdDefs: FROM "bcddefs". 

BinaryDefs: FROM "b inarydef s" , 

ControlDefs: FROM "controldefs" , 

ErrorTabDefs: FROM "errortabdef s" , 

InlineDefs: FROM "in! inedef s" , 

lODefs: FROM "iodefs", 

ListerDefs: FROM "1 isterdef s" , 

Mopcodes: FROM "mopcodes", 

MiscDefs: FROM "miscdefs", 

OpTableDefs: FROM "optabledef s" , 

OutputDefs: FROM "outputdef s" , 

SegmentDeFs: FROM "segmentdef s" , 

StringDefs: FROM "stringdef s" , 

Symbol FableDefs: FROM "symbol tabledefs" , 

SymDefs: FROM "symdefs", 

SymSegDefs: FROM "symsegdef s" , 

SystemDefs: FROM "sys temdef s" , 

TableDefs: FROM "tabledefs", 

TimeDefs: FROM "timedefs", 

TreeDefs: FROM "treedefs"; 

DEFINITIONS FROM OutputDefs; 

ListerRoutines: PROGRAM 

IMPORTS AllocDefs, BinaryDefs, MiscDefs, OutputDefs, SegmentDefs, SystemDefs 

EXPORTS ListerDefs, TableDefs SHARES SymbolTableDeFs = PUBLIC 

BEGIN 

BYTE: TYPE == Al toDef s . BYTE ; 

FileSegmentHandle: TYPE = SegmentDefs . FileSegmentHandle; 

FrameHandle: TYPE = ControlDefs. FrameHandle; 

NumberFormat : TYPE = lODef s .NumberFormat; 

opcode: TYPE = BYTE; 

PageCount: TYPE = Al toDef s . PageCount; 

WordPC: TYPE = ControlDefs .WordPC; 



IncorrectVersion: SIGNAL = CODE; 
NoFGT: SIGNAL « CODE; 
NoCode: SIGNAL = CODE; 
NoSymbols: SIGNAL = CODE; 
MultipleModules: SIGNAL = CODE; 
version, creator: BcdDefs .VersionStamp; 
Dstar: BOOLEAN; 
filename: STRING; 

symbols : Symbol TableDefs .Symbol Tab leBase; 
base: ARRAY [0..15] OF Tabl eDef s .Tabl eBase; 

SetRoutineSymbols: PROCEDURE [s: SymbolTabl eDef s .SymbolTableBase] 
BEGIN 
symbase: TableDefs .TableBase ^ LOOPHOLE[s . stHandle] ; 

symbols <- s; 

BEGIN OPEN s. StHandle; 

base[SymDef s . Iittype] ^ symbase + htB lock, off set; 

base[SymDef s . sstype] ♦- symbase + ssB lock .of fset; 

base[SymDef s . setype] <- symbase + seBlock. of f set ; 

baseiSymOef s . ctxtype] ♦- symbase + ctxBlock .of f set; 

base[SymDefs .mdtype] ^ symbase + mdBlock .of f set ; 

base[SymDef s .bodytype] <- symbase + bodyBlock . of Fset ; 

base[SymSegDefs . exttype] <- symbase + extBlock .of f set ; 

base[SymSegDef s . treetype] ^ symbase + treeBlock. offset; 

base[SymSegDef s . 1 1 type] *- symbase + 1 itBlock.off set; 

UpdateBases[] ; 

END; 

END; 

-- communication 
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NotifyNode: TYPE « RECORD [ 

notif ier: TableDeFs. TableNotif ier , 
link: POINTER TO NotifyNode]; 

notifyList: POINTER TO NotifyNode ^ NIL; 

AddNotify: PUBLIC PROCEDURE [proc: TableDefs . TableNotif ier] « 
BEGIN 

p: POINTER TO NotifyNode = SystemDef s.ATlocateHeapNode[SIZE[NotifyNode]] ; 
pt <- [notif ier:proc, 1 ink:notifyList] ; 
notifyList ♦- p; 

proc[DESCRIPTOR[base]]; RETURN 
END; 

DropNotify: PUBLIC PROCEDURE [proc: TableDefs .TableNotif ier] » 
BEGIN 

p, q: POINTER TO NotifyNode; 
IF notifyList « NIL THEN RETURN; 
p ^ notifyList; 
IF p.notifier = proc 

THEN notifyList ^ p. link 
ELSE 
BEGIN 
DO 

q <- p ; p <- p. 1 ink; 
IF p = NIL THEN RETURN; 
IF p.notifier = proc THEN EXIT 
ENDLOOP; 
q. 1 ink <- p . 1 ink; 
END; 
SystemDefs.FreeHeapNode[p]; RETURN 
END; 

UpdateBases: PROCEDURE « 
BEGIN 

p: POINTER TO NotifyNode; 

FOR p <- notifyList. p. link UNTIL p = NIL DO p. notif ier[OESCRIPTOR[base]] ENDLOOP; 
RETURN 
END; 

-- to make Treelnit happy 

GetChunk: PROCEDURE [size: CARDINAL] RETURNS [TableDefs .Tablelndex] » 
BEGIN 

IF size # TreeDefs .TreeNodeSize THEN ERROR; -~ called to reserve empty 
RETURN [LOOPHOLE[0]]; 
END; 

Load: PROCEDURE [name: STRING] RETURNS [code, symbols: Fil eSegmentHandl e] = 
BEGIN OPEN SegmentDefs; 
bcdseg: FileSegmentHandle; 
bed: POINTER TO BcdDefs.BCD; 
sgb: CARDINAL; 
pages: Al toDef s . PageCount ; 
codefile: FileHandle; 
mh: BcdDefs.MTHandle; 

code «- symbols <- NIL; 

Dstar <- FALSE; 

filename ^ name; 

codefile ^ NewFile[name, Read, Defaul tVersion] ; 

bcdseg <- NewFileSegment[codef i le , 1, 1, Read]; 

Swapln[bcdseg] ; 

bed <- FileSegmentAddress[bcdseg] ; 

IF (pages <- bcd.nPages) § 1 THEN BEGIN 

Unlock[bcdseg]; 

MoveFileSegment[bcdseg, 1, pages]; 

Swapln[bcdseg] ; 

bed <- FileSegmentAddress[bcdseg]; 

END; 
BEGIN 
ENABLE 

UNWIND «> BEGIN Unlock[bcdseg] ; DeleteFileSegment[bcdseg] END; 
IF bed . versionident ff BcdDef s . Vers ionID THEN SIGNAL IncorrectVersion; 
version <- bed. version; , 
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creator ^ bed. creator; 

mh <r LOOPHOLE[bccl, CARDINAL]+bcd .mtOf f S8t+FIRST[BcdDef s .MTIndex] ; 

sgb <r LOOPHOLE[bcd, CARDINAL]+bcd. sgOff set ; 

IF bcd.nModules ^ 1 THEN SIGNAL MultipleModules ; 

IF bed. definitions THEN SIGNAL NoCode 

ELSE 

BEGIN 

code ^ NewFi1eSegment[codef ile, 

(sgb+mh. code. sgi) .base, (sgb+mh .code. sgi) .pages , Read]; 

code. class ^ code; 

END; 
IF (sgb+mh. sseg) .pages « THEN SIGNAL NoSymbols 
ELSE 

BEGIN 

IF (sgb+mh. sseg). extraPages « THEN SIGNAL NoFGT; 

symbols <- NewFileSegment[codef ile, 

(sgb+mh. sseg) .base, (sgb+mh . sseg) .pages+( sgb+mh. sseg) .extraPages, Read]; 

END; 
END; 
IF code ^ NIL THEN 

BEGIN 

p: POINTER TO Control Defs . CSegPrefix ; 

SwapIn[code]; 

p ^ FileSegmentAddress[code] ; 

Dstar ^ p. fill =» 1; 

Unlock[code] ; 

END; 
Unlock[bcdseg]; DeleteFileSegment[bcdseg]; 
RETURN 
END; 

WriteVersions: PROCEDURE [version, creator: POINTER TO BcdDef s . VersionStamp] «= 
BEGIN OPEN OutputDefs; 
PutString[" created "L]; 
PutTime[version . time]; 
PutString[" on "L]; 
PrintMachine[versiont]; 
PutCR[]; 

PutString[" creator "L]; 
Pu tTime[crea tor . time]; 
PutString[" on "L]; 
PrintMachine[creatort]; 
PutCR[]; PutCR[]; 
RETURN 
END; 

PrintMachine: PROCEDURE [stamp: BcdDef s .VersionStamp] = 
BEGIN 

octal: NumberFormat = [8, FALSE , FALSE . 1] ; 
PutNumber[stamp .net , octal]; 
PutChar['i^]; 

PutNumber[stamp.host , octal]; 
PutChar['j^]; 

IF stamp. zapped THEN PutString[" zappedT'L]; 
RETURN 
END; 

WriteFilelD: PROCEDURE » 
BEGIN 

PutString[f ilename]; 
IF Dstar THEN PutString[" (/-A)"L]; 
Dstar <- FALSE; 

Write\/ersions[@version, ^creator] ; 
RETURN 
END; 

PrintHti: PROCFDURE [hti: SymDefs .HTIndex] - 
BEGIN 

desc: Str ingDef s .SubStringDescriptor ; 
s: StringDefs. Substring = 0desc; 

IF hti « SymDefs. HTNull THEN PutString["( anonymous) "] 
ELSE 

BEGIN 

symbols .SubStringForHash[s , hti]; PutSiibString[s]; 

END; 
RETURN 
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END; 

PrintSei: PROCEDURE [sei: SymDef s . ISEIndex] " 
BEGIN 

PrintHti[IF sei^SyrnDef s .SENull THEN SymDef s . HTNul 1 ELSE (symbol s . seb+sei ). htp tr] ; 
RETURN 
END; 

Indent: PROCEDURE [n: CARDINAL] » 
BEGIN 
PutCR[]; 

THROUGH [l,.n/8] DO PutChar[IODef s .TAB] ENDLOOP; 
THROUGH [l..n MOD 8] DO PutChar[' ] ENDLOOP; 
RETURN 
END; 

PutSubString: PROCEDURE [ss: StringDefs .Substring] » 
BEGIN 

i; CARDINAL; 
FOR i IN [ss. offset. .ss.offset+ss. length) 

DO 

PutChar[ss.base[i]] 

ENDLOOP; 
RETURN 
END; 

-- csrP and desc.base are set by SwapInStringTab 

stringTableSeg: SegmentDefs .FileSegmentHandle; 

csrP: ErrorTabDefs.CSRptr; 

desc : StringDefs .SubStringDescriptor; 

ss: StringDefs. Substring = Odesc; 

SwapInStringTab: PROCEDURE « 
BEGIN OPEN AllocDefs; 

info: Alloclnfo = [0, hard, bottomup, initial , other .TRUE, FALSE]; 
[stringTableSeg, ] <- MiscDef s .DestroyFakeModul e[LOOPHOLE[BinaryDef s .ErrorTab]]; 
MakeSwappedIn[stringTableSeg , SegmentDefs.Def aul tBase, info]; 
csrP <- LOOPHOLE[SegmentDefs.FileSegmentAdd res s[ StringTableSeg]]; 
ss.base ^ LOOPHOLE[csrP + csrP. relativebase, STRING]; 
RETURN 
END; 

PutNodeName: PROCEDURE[n: TreeDef s .NodeName] » 
BEGIN 

ss. offset ^ csrP.NodePrintName[n] .of fset; 
ss. length <- csrP.NodePrintName[n] . length; 
PutSubString[ss]; RETURN 
END; 

SwapInStringTab[]; 

END.. 



